perm filename PLTCMD.F4[MSS,LCS]5 blob sn#106254 filedate 1974-06-08 generic text, type T, neo UTF8
00100	C**** PLTCMD, FILLMS, ROTATE ********
00200		SUBROUTINE PLTCMD
00300	CC	IMPLICIT INTEGER(A-Q,S-Z)
00400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00500		DIMENSION NMS(8),RMOV1(8),RMOV2(8)
00600		COMMON /DL/X22,SAVER,NAME /ALF/INP(3),ML
00700		COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
00800		EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
00900		1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(I3,INP(3))
01000		F78F(1)='(78F)'
01100		FA5(1)='(A5) '
01200		FA1(1)='(A1) '
01300	
01400		IF(I2.NE.'X')GO TO 1
01500	CC	ML=' '
01600		I2=0
01700		RXC=0
01800		RMOV1(1)='Y'
01900		NAME=0
02000	14	KA=0
02100	3	KA=KA+1
02200	CC	IF(ML.EQ.' ')GO TO 15
02300		IF(ML.EQ.0)GO TO 15
02400		K=K-2
02500		ML=ML-1
02600		IF(ML.EQ.0)GO TO 10
02700		GO TO 31
02800	15	TYPE 2,KA
02900		ACCEPT 11,K,ML
03000	C  TYPE LAST NAME, NUMBER  FOR A SERIES
03100	50	IF(K.EQ.' ')GO TO 10
03200		IF(K.EQ.'99')GO TO 140
03300	C  99=BACKUP
03400	31	IF(LOOKD(K))GO TO 56
03500	C JUMP IF FILE FOUND
03600		TYPE 55
03700		GO TO 15
03800	55	FORMAT(' FILE NOT FOUND'/)
03900	11	FORMAT(A5,I)
04000	56	NMS(KA)=K
04100	CC	IF(ML.EQ.' ')GO TO 5
04200		IF(ML.EQ.0)GO TO 5
04300		RJH='Y'
04400		GO TO 21
04500	5	TYPE 8
04600		ACCEPT FA5,RJH
04700		IF(RJH.EQ.'99')GO TO 15
04800		IF(RJH.NE.'Y')RJH=0
04900		IF(RJH.EQ.0)REREAD F78F,RJH
05000	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
05100	21	RMOV1(KA+1)=RJH
05200		RMOV2(KA)=RJH
05300		GO TO 3
05400	140	KA=KA-1
05500		GO TO 15
05600	
05700	10	KB=KA-1
05800		IF(I3.NE.'G')GO TO 22
05900		RSIZ=1
06000		GO TO 222
06100	22	TYPE 9
06200		ACCEPT F78F,RSIZ
06300		IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
06400	222	KA=0
06500	
06600	1	IF(NAME.NE.0)GO TO 12
06700		IF(KA.EQ.KB)GO TO 100
06750	C  EXITB IS FOR FR80 RELEASE ****************
06800		NAME=NMS(KA+1)
06900		TYPE 111,NAME
07000		RETURN
07100	12	KA=KA+1
07200		NAME=0
07300		RJD=1
07400		IF(INP(3).EQ.'C')RJD=0
07500	C  'PXC' = CALCOMP OUTPUT
07600		RJH=0
07700		RJB=RSIZ
07800		RJC=RSIZ
07900		RJG=0
08000		RJE=1
08100		RJF=1
08200		IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
08300		IF(RMOV1(KA).NE.0)RJE=0
08310		IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
08350		RETURN
08375	100	TYPE 101
08380		ACCEPT 11,K
08385		IF(K.EQ.'Y')CALL EXITB
08390		CALL EXIT
08395	101	FORMAT(' FOR FR80?? -- '$)
08500	2	FORMAT(' TYPE FILE NAME',I2,1X$)
08600	8	FORMAT(' MOVE UP AT END? ',$)
08700	9	FORMAT(' SIZE FACTOR? ',$)
08800	111	FORMAT(1XA5/)
08900		END
25460	
25500	C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
25600		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
25700		COMMON/DL/IXRX,SAVER,NAME
25800		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
25900		DIMENSION IDAT(1)
26000		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
26100		DATA MP/2/,MD/6/
26200	C MD=DISPLAY   MP=PLOTTER   MX=XGP
26300		DX=DIS
26400		RX=RHT
26500		D=RSTJC*RJF
26600		R=RSTJC*RJG
26700	4	GO TO 1
26800		C=CC
26900		B=BB
27000	C  SAVES IT.  IT WILL RETURN LATER.
27100		BB=B/DIS
27200		CC=1000
27300	1	KK=0
27400		DO 205 J=1,L
27500		CALL UNPACK(M,N,IDAT(J))
27600		KK=KK+1
27700		NX(KK)=0
27800		IF(LL.EQ.3)NX(KK)=3
27900		X(KK)=ROFF((RJB+D*M)*DIS)
28000		Y(KK)=ROFF((CENTR+R*N)*RHT)
28100	3	GO TO 205
28200		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
28300	C  FOR DISTORTION
28400	205	CONTINUE
28500		NX(1)=KK
28600		DIS=1.0
28700		RHT=DIS
28800		M=MD
28900		IF(IPLT)M=MP-IXRX
29000	C  STOPS DISTORTION IN 'LINES'
29100	2	CALL FILLER(X,Y,NX,M)
29200		DIS=DX
29300		RHT=RX
29400	5	RETURN
29500	C  NEXT TO RESET DISTORTION FACT.
29600		BB=B
29700		CC=C
29800		RETURN
29900		END
30000	
30100		SUBROUTINE ROTATE(I,L,DEG)
30200		DIMENSION I(1)
30300		N=I(L)
30400		KNT=501
30500	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 501.
30600		I(KNT)=N
30700		DO 1 K=L+1,N+L-1
30800		CALL UNPACK(J,M,I(K))
30900		X=J
31000		Y=M
31100		JJ=I(K)/100000000
31200		AX=ATAN2(X,Y)*57.29578
31300		HYP=SQRT(X**2+Y**2)
31400		ROT=DEG+AX
31500		J=ROFF(HYP*COSD(ROT))
31600		M=ROFF(HYP*SIND(ROT))
31700		KNT=KNT+1
31800		IF(J)J=1000-J
31900		IF(M)M=1000-M
32000	1	I(KNT)=M*10000+J+JJ*100000000
32100		L=501
32200		END